home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / t / op / hashwarn.t < prev    next >
Text File  |  1998-05-15  |  2KB  |  72 lines
  1. #!./perl
  2.  
  3. BEGIN {
  4.     chdir 't' if -d 't';
  5.     @INC = '../lib';
  6. }
  7.  
  8. use strict;
  9.  
  10. use vars qw{ @warnings };
  11.  
  12. BEGIN {
  13.     $^W |= 1;        # Insist upon warnings
  14.     # ...and save 'em as we go
  15.     $SIG{'__WARN__'} = sub { push @warnings, @_ };
  16.     $| = 1;
  17.     print "1..7\n";
  18. }
  19.  
  20. END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
  21.  
  22. sub test ($$;$) {
  23.     my($num, $bool, $diag) = @_;
  24.     if ($bool) {
  25.     print "ok $num\n";
  26.     return;
  27.     }
  28.     print "not ok $num\n";
  29.     return unless defined $diag;
  30.     $diag =~ s/\Z\n?/\n/;            # unchomp
  31.     print map "# $num : $_", split m/^/m, $diag;
  32. }
  33.  
  34. sub test_warning ($$$) {
  35.     my($num, $got, $expected) = @_;
  36.     my($pattern, $ok);
  37.     if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
  38.     (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
  39.         # it's a regexp
  40.         $ok = ($got =~ /$pattern/);
  41.         test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
  42.     } else {
  43.     $ok = ($got eq $expected);
  44.     test $num, $ok, "Expected string '$expected', got '$got'\n";
  45.     }
  46. #   print "# $num: $got\n";
  47. }
  48.  
  49. my $odd_msg = '/^Odd number of elements in hash/';
  50. my $ref_msg = '/^Reference found where even-sized list expected/';
  51.  
  52. {
  53.     my %hash = (1..3);
  54.     test_warning 1, shift @warnings, $odd_msg;
  55.  
  56.     %hash = 1;
  57.     test_warning 2, shift @warnings, $odd_msg;
  58.  
  59.     %hash = { 1..3 };
  60.     test_warning 3, shift @warnings, $odd_msg;
  61.     test_warning 4, shift @warnings, $ref_msg;
  62.  
  63.     %hash = [ 1..3 ];
  64.     test_warning 5, shift @warnings, $ref_msg;
  65.  
  66.     %hash = sub { print "ok" };
  67.     test_warning 6, shift @warnings, $odd_msg;
  68.  
  69.     $_ = { 1..10 };
  70.     test 7, ! @warnings, "Unexpected warning";
  71. }
  72.